# I/O related functions that either do I/O themselves or parse files into 
# drDobus specific data structures 
###############################################################################

#' Read internal data, i.e. test its existence and return a copy.
#' 
#' An R object is returned if it exists and is unique.
#' @param file A character string naming the R object.
#' @author Bastian R. Angermann
readInternal <-function(file)
{
    if(!is.character(file) ||  length(file)!=1)
        submitToLog("'filename' must be character vector of length 1. This is an internal error. Please contact the package maintainer.","Error")
    #TODO maintain list of data types which make shallow copies on <- and implement special cases.
    objectsWithSameName <- eval(substitute(getAnywhere(x), list(x=file)))
    nObjects <- length(objectsWithSameName$objs)
    if ( nObjects == 0 ) # non defined try to load an action form disk.
        submitToLog(paste("Internal file", file, "missing"), "Error")
    else if (nObjects == 1) return(objectsWithSameName$objs[[1]])
    else submitToLog(paste("Internal file", file, "is not unique"), "Error") 
}
#' Read internal data (an R object) from a file.
#' 
#' An R object is read from a Rdata file. The Rdata file must contain exactly one object otherwise an error is
#' thrown.
#' @param file A character string naming the file to read from.
#' @author Bastian R. Angermann
readInternalFromFile <-function(file)
{
    if(!is.character(file) ||  length(file)!=1)
        submitToLog("'filename' must be character vector of length 1. This is an internal error. Please contact the package maintainer.","Error")
    environment <- new.env()
    load(file,environment) # no need for try catch here this is done in the calling function (readData)
    fileContent <- ls(environment) 
    if (length(fileContent)!=1)
        submitToLog(paste("The RData file", file, "must contain exactly one object"), "Error")
    loadedItem <- eval(substitute(get(x, inherit=FALSE, envir=environment),list(x=fileContent)) )
    rm(list = ls(environment),envir=environment)

    return(loadedItem)
}  
#' Write a data file to an RData file
#' 
#' details
#' @param data the R object to be written
#' @param file the filename to which the data should be written.
#' @author Bastian R. Angermann
writeData <- function(data, file)
{
    if (!file.exists(file))
        tryCatch(save(data, file=file),
                #warning=function(x) submitToLog(paste("Unable to write", file,":",warnings(), sep=" "), "Error" ), 
                error=function(x) submitToLog(paste("Unable to write", file, sep=" "), "Error" ) ) 
    else
        submitToLog(paste("Can't write output data to disk,", file,"already exists."),"Error")   
}

#' Read a CSV file safely into a data frame
#'
#' @param file A character string naming the file to read from.
#' @return A dataframe of the file contents. Strings will not be converted into factors.
#' @author Bastian R. Angermann
readCsvFile <- function(file)
{
    if(!is.character(file) ||  length(file)!=1)
        submitToLog("'filename' must be character vector of length 1. This is an internal error. Please contact the package maintainer.","Error")
    errorFunction <- function (x)
    {
        if (!file.exists(file))# only done in tryChatch as the file might be deleted in the time between testing its existence and attempting to open it.            
            message <- paste("The file", file, "does not exist, or can not be accessed.")         
        else
            message <- paste(file, "is probably not formatted correctly.")
        submitToLog(paste("Unable to open", file, "present working directory is", getwd(),".", message, sep=" "), "Error" )
    }
    tryCatch(read.csv(file,row.names=NULL, stringsAsFactors=FALSE,check.names=FALSE),
            warning=errorFunction, 
            error=errorFunction )
}

#' A list of functions to open files of different type.
#' 
#'  List elements are named by the file type the corresponding function reads.
readableFileTypes <- list("INTERNAL"=readInternal,
        "RDATA"=readInternalFromFile,
        "CSV"=readCsvFile)

#' Register a new file type in drDobus
#' 
#' This function registers new file types for drDobus, and will typically be used from libraries providing new actions.
#' @param tag A character string containing the tag used to identify files of a certain type in dataLocation files.
#' @param readFunction a function for reading files of the given type.
#' @return invisible Null, this function is called for its side effect
registerFileType <- function(tag,readFunction)
{
    if (tag %in% names(drDobus:::readableFileTypes) )
        if (identical(readFunction,drDobus:::readableFileTypes[[tag]]))
            submitToLog(paste("An identical function with the same tag(",tag,") is already registered"),"Note")
        else
            submitToLog(paste("A different function with the same tag(",tag,") is already registered"),"Error")
    readableFileTypes <- drDobus:::readableFileTypes
    readableFileTypes[[tag]]=readFunction
    assignInNamespace("readableFileTypes", readableFileTypes, "drDobus")
    invisible(NULL)
}

#' Write a list of file types understood by drDobus to the standard output
#' 
#' The types are the tags understood by the dataLocationFile in the csv protocol specification and will
#' also be supported by the XML file format.
getReadableFileTypes <- function()
{
    typeList <- names(readableFileTypes)
    invisible(sapply(typeList,function(x) cat(paste(x,"\n",sep=""))))
}

#' Writes a list of files to a CSV file.
#' 
#' A list of files is written to a CSV file that can serve as a specification of input data for a protocol.
#' The file type is set to "RDATA" and the CSV file is structured such that the files will be read sequentially.
#' This function is used internally to write a list of files generated by an action(application).
#' @param file A character string naming the file to which the CSV is written.
#' @param fileList A list of character strings naming the files in the file list.
#' @author Bastian R. Angermann 
writeCsvFileList <- function(file,fileList)
{
    fileList <- matrix(data=fileList,ncol=1)
    colnames(fileList) <- "RDATA"
    writeCsvFile(file=file,data=fileList)
}                  
                  
#' Write a CSV file safely do disk
#' 
#' @param file A character string naming the file read from
#' @param data An object that can be coerced into a dataframe that will be written to file
#' @author Bastian R. Angermann
#' @export 
writeCsvFile <- function(file,data)
{
    if(!is.character(file) ||  length(file)!=1)
        stop("'filename' must be character vector of length 1")
    tryCatch(write.csv(x=data,file=file,row.names=FALSE),
            warning=function(x) {submitToLog(paste("Unable to write", file, sep=" "), "Error" )}, 
            error=function(x) {submitToLog(paste("Unable to write", file, sep=" "), "Error" )})
}
#' Read a CSV file into a list of named parameter values
#' 
#' A CSV file with name, value, type triples is read from a connection and a named list of parameters is returned.
#' The following types are valid
#' \describe{
#' \item{numeric}{A single numeric value}
#' \item{character}{A single character string}
#' \item{list}{A list of character strings} 
#' \item{passthroughFileList}{In some cases an input file list (in CSV format, stored in a file) needs to be passed directly to an action instead of being 
#' interpreted by the pipeline. Use this to prevent said interpretation and make the execute function pass the reference to the file list instead of iterating over it. 
#'  the reference itself can be a list of files that make up the columns of the indata.  }}
#' @param file A character string naming the file read from
#' @author Bastian R. Angermann
readCsvSettings <- function(file)
{
    csvTable <- readCsvFile(file)
    typeCast <- list("numeric"=as.numeric,"character"=as.character,
                     "list"=function(x) as.list(unlist( strsplit(x, "|", fixed =TRUE) ) ),
                     "passthroughFileList"=function(x) {x<-as.character(x); 
                                                        attr(x,which="Type") <- "CSV";
                                                        return(new(Class="PassthroughFileList",x)) },# Some actions have to iterate themselves, pass the file list directly to the using this tag
                     "rDataFile"=function(x)  new(Class="RDataFile",unlist( strsplit(x, "|", fixed =TRUE) )) ) 
    settings <- list() # FIXME passthroughFileList is used twice in different contexts rename one.
    if (nrow(csvTable)==0)
        return(settings)
    # TODO: vectorize
    for (i in 1:nrow(csvTable))
    {
        settings[[csvTable[i,1] ]] <- typeCast[[ csvTable[i,3] ]](csvTable[i,2]) # TODO trycatch wrong types        
    }
    settings 
}

#' Read a CSV file list into a list of n-tuples of file names
#' 
#' A CSV file is read and each of it's rows except the first is a turned into a list. 
#' The first row serves as a header indicating the file type, which is stored as an attribute of the corresponding 
#' element of the lists generated.
#' @param file A character string naming the file read from
#' @author Bastian R. Angermann
readCsvFileList <- function(file)
{
    csvTable <- readCsvFile(file)
    fileListFromDataframe(csvTable) 
}
#' Read a data files of various types
#' 
#' readData serves as a dispatch mechanism for functions reading files of various formats. The "Type" attribute
#' of its "file" parameter is used to determine which functions is used to read the file. Functions for opening files
#' are stored in the list drDobus:::readableFileTypes
#' @param file A character string naming the file read from. See Details.
#' @seealso readableFileTypes
#' @author Bastian R. Angermann
#' @export
readData <- function(file)
{
    type <- toupper(attr(file,which="Type"))
    if (type %in% names(drDobus:::readableFileTypes))
    { 
        inData <- tryCatch(drDobus:::readableFileTypes[[type]](file),
           #flowCore generates warnings warning=function(x) submitToLog(paste("Unable to open", file, "present working directory is", getwd(), sep=" "), "Error" ), 
            error=function(x) submitToLog(paste("Unable to open", file, "present working directory is", getwd(), sep=" "), "Error" ) )
    } else
        submitToLog(paste("Unknown file type", type),"Error")
    return(inData)
}

#' Set the working directory
#' 
#' A save way to set the working directory, the file argument can be both a regular file or a directory.
#' If the argument is a regular file the working directory will be set to the directory containing the file.
#' Any failure to set the working directory will be logged.
#' @param file A character string specifying the new working directory. See Details.
#' @return A character string specifying the new working directory.
#' @author Bastian R Angermann
setWorkingDirectory <- function(file)
{
    isDir <- file.info(file)[,"isdir"]
    if (is.na(isDir)) 
        submitToLog(paste("Cannot get file stats on",file,", does the path really exist?"),"Error")
    if (!isDir ) # we need special handling since dirname returns the dirname of the dir containing its argument no matter whether is is a file or dir
        file <- dirname(file)
    tryCatch(setwd(file),
            warning=function(x) submitToLog(paste("Unable to set  working directory to", dirname(file), sep=" "), "Error" ), 
            error=function(x) submitToLog(paste("Unable to set  working directory to", dirname(file), sep=" "), "Error" ) )      
    submitToLog(paste("Working directory changed to",getwd()),"Note")
    return(getwd())
}


#' Returns base file name for file output
#' 
#' The baseName is used internally to generate the filenames of the various data outputs.
#' @param protocolApplication The ProtocolApplication for which a file name is generated
getBaseName <- function(protocolApplication)
{
    actionName <- attr(protocolApplication@.action, which="name")
    baseName <- paste(protocolApplication@name, actionName, sep="_")
    if (!is.null(protocolApplication@outputData))
        baseName <- file.path(protocolApplication@outputData,baseName)
    return(baseName)
}
#' Returns file name for lists of file output
#' 
#' The listFile is used internally to generate the filename of the file containing the list of output files of a 
#' protocol application.
#' @param protocolApplication The ProtocolApplication for which a file name is generated
getListFileName <- function(protocolApplication)
{
    baseName <- getBaseName(protocolApplication)
    listFileName <- paste(baseName,"FileList.lst",sep="_")
    return(listFileName)
}

#' Reads an XML file and parses it.
#' 
#' @param fileName A character string specifying which file to open.
readXML <- function(fileName)
{
    tryCatch(xmlInternalTreeParse(file=fileName, error=NULL),
            warning=function(x) submitToLog(warnings(), "Warning" ), 
            error=function(x) submitToLog(paste("Unable to parse the XML file ", fileName, sep=" "), "Error" ) )      
}
